home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / ovrobj.com / OVERLOCK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-05  |  4.6 KB  |  160 lines
  1. {
  2.  
  3. OvrLock is a function that places a "lock" on the overlay buffer.  Any units
  4. present in the overlay buffer when the lock is applied will remain fixed in
  5. memory until the lock is removed.  While the lock is in effect the overlay
  6. manager continues to operate normally using the balance of the overlay buffer
  7. and the remaining overlaid units.
  8.  
  9. It is the programmer's responsibility to load the desired units into
  10. the overlay buffer before calling OvrLock.  One way to accomplish this 
  11. is by doing a OvrClearBuf and then a dummy call to each unit.  For example:
  12.  
  13.   OvrClearBuf;
  14.   Unit1_dummy;
  15.   Unit2_dummy;
  16.   OvrLockResult := OvrLock;
  17.  
  18. OvrLock returns an integer result code. The following result codes are
  19. defined:
  20.  
  21. 0  Successful completion.
  22. 1  Overlay buffer is empty.  There are no units to lock.
  23. 2  Free space not at end of buffer.  OvrLock requires all units in the
  24.    overlay buffer to be loaded contiguously at the beginning of the buffer.
  25. 3  Overlay buffer already locked.  Only one lock can be placed on the overlay
  26.    buffer at a time.  If you want to lock more units into the buffer, first
  27.    call OvrUnlock, load the additional unit(s), and then call OvrLock again.
  28. 4  Not enough free space left.  There must be enough free space left in the
  29.    buffer for the largest overlaid unit that is not already loaded.
  30.  
  31.  
  32. OvrUnlock removes the lock from the overlay buffer.  All units that were
  33. locked remain in the buffer when OvrUnlock is called.  All other units are
  34. cleared.  OvrUnlock returns an integer result code.  The following result codes
  35. are defined:
  36.  
  37. 0  Successful completion.
  38. 1  Overlay buffer is not locked.
  39.  
  40.  
  41. Written by Ron Schuster (CIS 76666,2322).  Copyright (c) 1989.
  42. All rights reserved.  May be distributed freely, but not for a profit.
  43.  
  44. Version 0.2, 12/05/89
  45. --------------------
  46.   Beta release.
  47. }
  48.  
  49. {$R-,S-,I-,V-,F-,B-,O-}
  50.  
  51. unit OverLock;
  52.  
  53. interface
  54.  
  55. uses
  56.   Overlay;
  57.  
  58.   function OvrLock : Integer;
  59.   function OvrUnlock : Integer;
  60.  
  61. implementation
  62.  
  63. type
  64.   DispatcherHeader = record
  65.     ReturnInt : Word;
  66.     ReturnOfs : Word;
  67.     FileOfs : LongInt;
  68.     CodeSize : Word;
  69.     FixupSize : Word;
  70.     EntryPts : Word;
  71.     CodeListNext : Word;
  72.     LoadSegment : Word;
  73.     Reprieved : Word;
  74.     LoadListNext : Word;
  75.   end;
  76.  
  77.   var
  78.     SaveOvrHeapOrg : Word;
  79.     SaveOvrHeapSize : Word;
  80.     SaveOvrLoadList : Word;
  81.  
  82.   function Max (A,B : Word) : Word;
  83.   begin
  84.     if A > B then
  85.       Max := A
  86.     else
  87.       Max := B;
  88.   end;
  89.  
  90.   function NextPara(Bytes : LongInt) : LongInt;
  91.   begin
  92.     NextPara := (Bytes+15) and $FFFFFFF0;
  93.   end;
  94.  
  95.   function OvrLock : Integer;
  96.   var
  97.     P : Word;
  98.   begin
  99.     if OvrLoadList = 0 then
  100.       OvrLock := 1  { Overlay buffer is empty }
  101.  
  102.     else if DispatcherHeader(Ptr(OvrLoadList,0)^).LoadSegment <> OvrHeapOrg then
  103.       OvrLock := 2  { Free space not at end of buffer }
  104.  
  105.     else if SaveOvrHeapOrg <> 0 then
  106.       OvrLock := 3  { Overlay buffer already locked }
  107.  
  108.     else begin
  109.       { Find largest overlaid unit that is not already loaded }
  110.       P := OvrCodeList;
  111.       SaveOvrHeapSize := OvrHeapSize;
  112.       OvrHeapSize := 0;
  113.       while P <> 0 do
  114.         with DispatcherHeader (Ptr(P+PrefixSeg+$10,0)^) do begin
  115.           if LoadSegment = 0 then
  116.             OvrHeapSize := Max (OvrHeapSize,
  117.               (NextPara(CodeSize) + NextPara(FixupSize)) shr 4);
  118.            P := CodeListNext;
  119.         end;
  120.  
  121.       { Compare largest unit's requirement to available buffer free space }
  122.       if OvrHeapEnd - OvrHeapPtr < OvrHeapSize then begin
  123.         OvrHeapSize := SaveOvrHeapSize;
  124.         OvrLock := 4;  { Not enough free space left }
  125.       end
  126.  
  127.       else begin
  128.         SaveOvrHeapOrg := OvrHeapOrg;    { Save values to }
  129.         SaveOvrLoadList := OvrLoadList;  { restore later }
  130.  
  131.         OvrHeapOrg := OvrHeapPtr; { Set start of buffer to start of free space}
  132.         OvrLoadList := 0;         { "Hide" loaded units from overlay manager }
  133.  
  134.         OvrLock := 0;  { Successful completion }
  135.       end;
  136.     end;
  137.   end;
  138.  
  139.   function OvrUnlock : Integer;
  140.   begin
  141.     if SaveOvrHeapOrg = 0 then
  142.       OvrUnlock := 1  { Overlay buffer not locked }
  143.  
  144.     else begin
  145.       OvrClearBuf;  { Remove any units above lock point }
  146.  
  147.       OvrHeapOrg := SaveOvrHeapOrg;  { Restore original values }
  148.       OvrLoadList := SaveOvrLoadList;
  149.       OvrHeapSize := SaveOvrHeapSize;
  150.  
  151.       SaveOvrHeapOrg := 0;  { Indicate no lock in effect }
  152.       OvrUnlock := 0;       { Successful completion }
  153.     end;
  154.   end;
  155.  
  156. begin
  157.   SaveOvrHeapOrg := 0;  { Indicate no lock in effect }
  158. end.
  159.  
  160.